COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	               H A N O I   .   V L I                      
C00005 00003	 Les tours de Hanoi 
C00012 ENDMK
C⊗;
;               H A N O I   .   V L I                      ;
;                                                          ;
;       Les Tours de HANOI    VLISP 10 . 3                 ;
;	Test de l'utilisation des ecrans DATA-MEDIAS       ;
;----------------------------------------------------------;
;       Jerome CHAILLOUX                                   ;
;                                                          ;
;       Universite de Paris VIII - Vincennes               ;
;       Route de la Tourelle 75012 Paris                   ;
;       Tel : 374 12 50 poste 299                          ;
;                                                          ;
;       I.R.C.A.M.                                         ;
;       31 Rue St Merri 75004 Paris                        ;
;       Tel : 277 12 33 poste 48-48                        ;
;----------------------------------------------------------;

;; 
; Ces 2 fonctions sont d'habitude sur VLISP.INI ;
;;
(DE TTYS (X Y S)
    ; edite la chaine S sur un ecran en TTY DM mode ;
    ; en position : Xieme ligne Yieme colonne ;
    (DISPLAY (APPEND [\177 \14 (LOGXOR \140 Y) (LOGXOR \140 X)]
		   (MAPCAR (MAKLIST S) 'CASCII)))))

(DE TYPE (filin)
   ; simule la commande moniteur .TYPE file ;
   (INPUT filin)
   (STATUS 17 (ASCII \15) 2)
   (DE EOF () 
	(REMPROP 'EOF EXPR) 
	(STATUS 1 20)
	(TERPRI) 
	(INPUT) 
	(&EOF))
   (ESCAPE &EOF (WHILE T (PRINC (READCH))))
   (STATUS 17 (ASCII \15) 0)
   filin)
; Les tours de Hanoi ;

(DE HANOI.REC (n depart arrivee inter)
   ; fonction recursive de calcul des mouvements ;
   (COND
     ((GZP n)
	(HANOI.REC (SUB1 n) depart inter arrivee)
	(VISUT n depart arrivee) 
        (HANOI.REC (SUB1 n) inter arrivee depart)))))

(DE VISUT (n depart arrivee ;; disk gomm)
   ; visualise le deplacement du disque n ;
   (TTYS 5 56 (SETQ nmouv (ADD1 nmouv)))
   (SETQ disk (CONCAT (DUPL n n) "*" (DUPL n n)) 
         gomm (CONCAT (DUPL " " n) "*" (DUPL " " n)))
   (UP depart)
   (GO depart arrivee)
   (DOWN arrivee)
   (SETQA TABOCC depart (CDR (TABOCC depart)))
   (SETQA TABOCC arrivee (CONS n (TABOCC arrivee))))
  

(DE UP (depart ;; l x)
   (SETQ 
	l (DIFFER maxdsk (LENGTH (TABOCC depart)) )
	; position / au debut de l'aiguille ;
	x (DIFFER (XAIG depart) n))
   (REPEAT l
	(SETQ l (SUB1 l))
	(TTYS (PLUS ypos l) x disk)
 	(TTYS (ADD1 (PLUS ypos l)) x gomm))))))

(DE GO (depart arrivee ;; fnt x1 x2 x d)
   ; voyage au dessus des aiguilles ;
   (SETQ x1 (XAIG depart) x2 (XAIG arrivee) x (DIFFER x1 n))
   (SETQ fnt (IF (GT x1 x2) 'DECR 'INCR))
   (SETQ d (CONCAT " " disk " "))
   (TTYS ypos (ADD1 (DIFFER x1 maxdsk)) gom)
   (REPEAT (ABS (DIFFER x1 x2))
	(TTYS ypos x d) 
        (fnt x))
   (TTYS ypos (ADD1 (DIFFER x2 maxdsk)) gom)))

(DE DOWN (arrivee ;; x y)
   (SETQ 
	x (DIFFER (XAIG arrivee) n) 
        y ypos)
   (REPEAT (SUB1 (DIFFER maxdsk (LENGTH (TABOCC arrivee))  ))
 	(TTYS (ADD1 y) x disk)
	(TTYS y x gomm)
	(SETQ y (ADD1 y)))))))

(DE PAIG (L XPOS ;; y)
   ; imprime le contenu de toute une aiguille ;
   ; cette fonction sert a initialiser tout le monde ;
   (SETQ y ypos)
   ; affiche la parti nue de l'aiguille ;
   (REPEAT (DIFFER maxdsk (LENGTH L))
      (TTYS y (DIFFER xpos maxdsk) gom) (SETQ y (ADD1 y)))
   ; affiche les disque sur l'aiguille ;
   (WHILE (LISTP L)
      (TTYS (PLUS ypos (DIFFER maxdsk (LENGTH L)))
	(DIFFER XPOS (CAR L))
        (CONCAT (DUPL (CAR L) (CAR L)) "*" (DUPL (CAR L) (CAR L))))
      (NEXTL L))
   ; affiche la base de l'aiguille ;
   (TTYS (PLUS ypos maxdsk) (DIFFER XPOS maxdsk) 
	(DUPL "-" (ADD1 (PLUS maxdsk maxdsk)))))

; HANOI ;

(DE HANOI ( ;; maxdsk ndsk n nmouv)
   ; sequenceur principal ;
   ; lecture du baratin ;
   (IFN (DIRECTORY '(LIS . JER) '(HANOI . DOC))
       (PRINT "Y a pas de fichier DSK:HANOI.DOC[LIS,JER].")
       (TYPE '(DSK (HANOI . DOC) (LIS . JER)))
       (UNTIL (TYI)))
   (PPIOT 0 1)  ; passage sur la page 1;
   (TTYS 5 30 "Les Tours de HANOI.")
   ; initialisation du b maximum de disques ;
   (SETQ maxdsk 9)
   (WHILE T
      (TTYS 6 30 "Combien voulez-vous de disques ?")
      (TTYS 7 30 "(0 pour terminer HANOI.)")
      ; initialisation du nb courant de disques ;
      (WHILE (OR (LZP (SETQ ndsk (DIFFER (TYI) \60)))
                 (GT ndsk 9)))
      (OR (NEROP ndsk) 
	(LESCAPE (PPIOT 0 0) 
		; master clear ;
		(DISPLAY '(\177 \36))   
		; pour faire peur aux petites filles ;
		(PRINT "Tape 'RETURN' pour provoquer la fin du monde.")
		(IF (NEQ (TYI) \15) (LESCAPE (INPUT) (RESET)))
		(PRINT "Deleted All Files")
		; passe sur le ppn de l'utilisateur ;
		(ALIAS)
		(MAPC (DIRECTORY)
		   (LAMBDA (L) (PRINT (CAR L) '/. (CDR L) '/ / DELETED)))
		; c'est vraiment la fin ;
 		(RUN '(SYS(KJOB)))  
	'Hanoi))
      ; effacement des messages ;
      (TTYS 5 55 "          ")
      (TTYS 6 30 "                                ")
      (TTYS 7 30 "                                ")
      ; 1ere ligne vide pour les aiguilles ;
      (SETQ ypos 12) 
      ; calcul l'emplacement d'un disque vide ;
      (SETQ gom (CONCAT (DUPL " " maxdsk) "*" (DUPL " " maxdsk)))
      (SETQ n [ndsk])
      (REPEAT (SUB1 ndsk) (SETQ n (CONS (SUB1 (CAR n)) n)))
      (SETQA TABOCC 1 n)
      (SETQA TABOCC 2 ())
      (SETQA TABOCC 3 ())
      (PAIG (TABOCC 1) (xaig 1))
      (PAIG (TABOCC 2) (xaig 2))
      (PAIG (TABOCC 3) (xaig 3))
      ; init du nb de position ;
      (SETQ nmouv 0)
      (HANOI.REC ndsk 1 2 3)))))

; le tableau d'occupation ;
(DA 'TABOCC 4)

; le tableau des positions des aiguilles ;
(DA 'XAIG 4 (LAMBDA (X) (X '(10 33 56))))

; on force le mode conversationnel ;
(OUTPUT)
(PRINT "Pour lancer il faut taper : (HANOI) ")